BEGIN "Taster"

COMMENT

    The TASTER program provides a way to look at AlphaHOST output before it
actually gets spooled to the Alphatype, because AlphaSPOOL will be of only
limited intelligence, and AlphaTEX practically none.  Obvious errors will
be detected and warnings will be issued for them.

    One problem anticipated is that during various periods in the near
future, there will be times when only SAIL or only SCORE will be running.
In these events, it would be desirable to have versions of the program
tailored to each operating system.  The changes would be minor and otherwise
the programs would be identical, and so the tailoring ought to be feasible.

    Now we have some checks necessary to check cog traffic.
These are the crowding conditions:

	h[i] >= g[i],
	g[i] >= g[i-1],
	h[i] >= h[i-1],
	g[i] > h[i-2].

Traffic at c:

	a)  1 if any chars entered or exited at c-1,
	b)  + 1 for each char entering at c,
	c)  + 1 for each char exiting at c.

If g[i]=c then b).
If h[i]=c-1 then c).
If g[i]=c-1 or h[i]=c-2 then a).

Traffic( n ) =

	(g[n] enters here)
	    + (g[n-1] enters here)
	    + (h[n-1] exits) + (h[n-2] exits) + (h[n-3] exits)
	    + (just DMA'd something).

   =    1
	    - (g[n-1] = g[n])
	    - (h[n-1] = g[n]-1) - (h[n-2] = g[n]-1) - (h[n-3] = g[n]-1)
	    - (DMA = g[n]-1).

Note that although this formula looks like it yields values up to 6, the
fact that h[i] >= g[i] makes the two conditions (g[n-1] = g[n]) and
(h[n-1] = g[n]-1) mutually exclusive, and thus the maximum traffic we
can have is 5.  We can also note that if g[n-1] does not equal g[n],
h[n-3] is at most g[n]-2 and will not contribute.

    Now there is a slightly different problem we have to cover.  That is
that although the cogs are still sent LR on RL-typeset lines, the traffic
conditions must be met RL.  Here, we can just turn the conditions around,
g's "entering" and h's "exiting".  The crowding conditions are:

	h[i] >= g[i],
	g[i] >= g[i-1],
	h[i] >= h[i-1],
	g[i] > h[i-2].

Traffic at c:

	a)  1 if any chars entered or exited at c+1,
	b)  + 1 for each char entering at c,
	c)  + 1 for each char exiting at c.

If h[i]=c then b).
If g[i]=c+1 then c).
If g[i]=c+2 or h[i]=c+1 then a).

Traffic( n ) =

	(h[n] enters here)
	    + (h[n+1] enters here)
	    + (g[n+1] exits) + (g[n+2] exits) + (g[n+3] exits)
	    + (just DMA'd something)

   =    1
	    - (h[n+1] = h[n])
	    - (g[n+1] = h[n]+1) - (g[n+2] = h[n]+1) - (g[n+3] = h[n]+1)
	    - (DMA = h[n]+1).

This of course means we cannot do h[n] when it happens, as we have to
wait until we get g[n+3].  Therefore, Traffic(n) could be the following
transformation:

	1
	    - (h[n-2] = h[n-3])
	    - (g[n-2] = h[n-3]+1) - (g[n-1] = h[n-3]+1) - (g[n] = h[n-3]+1)
	    - (DMA = h[n-3]+1).

;

REQUIRE "{⎇{⎇" DELIMITERS;

DEFINE twenty = true;
DEFINE debug = false;
DEFINE simpel = { ifc not DEBUG thenc SIMPLE endc ⎇;
DEFINE verbose = false;

DEFINE ! = { comment ⎇;
DEFINE cr = { ('15 & null) ⎇;
DEFINE lf = { ('12 & null) ⎇;
DEFINE crlf = { ('15 & '12) ⎇;

DEFINE backlash = 36;	! CRS backlash compensation;
DEFINE mincog = 2048;
DEFINE maxcog = 3781;
DEFINE maxX = 55487;
DEFINE maxY = 29190;
DEFINE A!natural = 1365;
DEFINE B!flat = 2047;

INTEGER infile, 	! Input file;
	word,		! 1-word input buffer;
	byte,		! Current input byte;
	byte!pointer,	! Position in input buffer;
	warnings,	! Number of non-fatal errors;
	state,		! CRS line mode:  LR, RL, blank;
	A,		! Horizontal multiplier;
	B,		! Vertical multiplier;
	X,		! Horizontal position in dot units;
	Y,		! Vertical position in feed units;
	DMA,		! Last location a cog entered or left;
	L,		! This line's left cog constraint;
	R,		! This line's right cog constraint;
	pos;		! Current position in cog ring;

INTEGER ARRAY  lc,rc[0:3];	! Most recent left and right cogs;

ifc TWENTY thenc
    DEFINE eof = {!skip!⎇;
    EXTERNAL INTEGER  !skip!;
elsec
    INTEGER  count, brchar, eof, badfile;
endc

BOOLEAN eol,		! Have we just done an end-of-line command? ;
	never!brite,	! At least one brightness command per spool;
	brite!ok;	! Decides if legal to change brightness;

SIMPEL PROCEDURE  Warning( STRING msg );
    BEGIN "Warning"
    warnings ← warnings + 1;
    PRINT( (crlf&"WARNING: "), msg, crlf );
    END "Warning";

SIMPEL PROCEDURE  Cleanup;
    BEGIN "Cleanup"
    ifc TWENTY thenc  CFILE( infile );  elsec  RELEASE( infile );  endc
    SetPrint( null, "T" );
    END "Cleanup";

SIMPEL INTEGER PROCEDURE  GetByte( STRING bad!spot(null) );
    BEGIN "Getbyte"
    INTEGER  temp;
    DO
	BEGIN
	IF  byte!pointer = 0  THEN
	    BEGIN
	    word ← WORDIN( infile );
	    IF  eof and bad!spot  THEN
		BEGIN "Fatal end of file"
		PRINT( "
** FATAL ERROR ** Unexpected end of input; this is improper when scanning
", bad!spot, (crlf & "Processing was interrupted after "), warnings,
" cautionary messages.
" );
		Cleanup;
		USERERR( 0, 0, "UNEXPECTED END OF FILE", "X" )
		END "Fatal end of file";
	    END;
	byte!pointer ← (byte!pointer + 1) MOD 4;
	END
    UNTIL (temp ← (word ← word ROT 9) LAND '777) LAND '400 or eof;
    RETURN( temp LAND '377 );
    END "Getbyte";

SIMPEL INTEGER PROCEDURE  GetWord( STRING where );
    RETURN( GetByte("low-order byte of "&where&".")
	   +(GetByte("high-order byte of "&where&".") LSH 8) );

SIMPEL INTEGER PROCEDURE  Cog( INTEGER x );
    RETURN( x/32 + mincog );

SIMPEL PROCEDURE  Adjust!Cogs;
    BEGIN "Adjust cogs"
    INTEGER  d;
    PRINT( "
Adjust cogs of previous character...
" );
    eol ← false;
    IF  state = 0  THEN
	Warning("Adjusting cogs not allowed when AlphaTEX is in blank state.");
    d ← GetWord( "cog adjustment" );
    lc[pos] ← lc[pos] + d;
    rc[pos] ← rc[pos] + d;
    ifc VERBOSE thenc   
	PRINT("This leaves cogs at [",lc[pos],",",rc[pos],"].",crlf);
    endc
    END "Adjust cogs";

SIMPEL PROCEDURE  Display!Message;
    BEGIN "Display message"
    INTEGER  i, len;
    STRING  mess;
    mess ← null;
    PRINT( "
Start a ", len ← byte, "-character message to the CRS display...
" );
    IF  len > 37  THEN
	Warning("Alphatype cannot display a " &
		CVS(len) & "-character message -- only 37 at most." );
    FOR  i ← 1 STEP 1 UNTIL len  DO
	BEGIN
	byte ← GetByte
( "message for Alphatype display ("&CVS(Length(mess))&" characters):"&mess );
	IF  (" " LEQ byte LEQ "Z")  or  ("a" LEQ byte LEQ "z")  THEN
	    mess ← mess & byte
	ELSE
	    Warning( "Character '" & CVOS(byte) &
		    " not in AlphaType display range." )
	END;
    PRINT( "CRS Display (",Length(mess)," characters):",mess,crlf );
    END "Display message";

SIMPEL PROCEDURE  Begin!Page;
    BEGIN "Start page"
    INTEGER  p;
    PRINT( "
Begin page...
" );
    state ← "LR";
    IF  not eol  THEN
	Warning(
"Without an end-of-line, some typesetting will be lost.");
    L ← GetWord("new leftmost cog");
    IF  L < mincog or L > maxcog  THEN
	Warning( CVS(L)&" is an illegal left cog value." );
    ARRCLR(lc,L);
    ARRCLR(rc,L);
    pos ← 0;
    Y ← GetWord("new baseline coordinate");
    IF  Y > maxY  THEN
	Warning("Baseline coordinate " & CVS(Y)
& (" is too large.  Should not exceed " & CVS(maxY) & ".") );
    p ← GetWord("new page number");
    IF  p > 9999  THEN
	Warning( CVS(p) & " is too large.  Limited to 4 decimal digits." );
    PRINT(
"Starting page ", p, ", down ", Y, " feed units, and over ", L, " cogs.
" );
    END "Start page";

SIMPEL PROCEDURE  End!of!Line;
    BEGIN "End of line"
    PRINT( "
End of line...
" );
    eol ← true;
    brite!ok ← true;
    IF  state = "LR"  THEN
	BEGIN
	state ← "RL";
	R ← GetWord("rightmost cog-setting");
	L ← 0;
	IF  R-backlash < rc[pos]  THEN
	    Warning("Right-cog limit should not be set to " & CVS(R) & "
because current rightcog + backlash compensation = " & CVS(rc[pos]+backlash) & ".")
	ELSE IF  R > maxcog+backlash  THEN
	    Warning("Right-cog cannot be set to " & CVS(R) &
		(" -- maximum possible value is " & CVS(maxcog+backlash)) );
	ifc VERBOSE thenc
	    PRINT("New rightmost cog = ",R,crlf);
	endc
	END
    ELSE
	BEGIN
	IF  state NEQ "RL"  THEN
	    Warning(
		"Impossible to be at end of line while still in blank state.");
	state ← "LR";
	L ← GetWord("leftmost cog-setting");
	IF  L+rc[pos] > R  THEN
	    Warning(
"Left-cog should not be set to " & CVS(L) & " because then the line goes to
" & CVS(L+rc[pos]-backlash) & ", past its right margin at "&CVS(R-backlash)&".");
	ifc VERBOSE thenc
	    PRINT("New leftmost cog = ",L,crlf);
	endc
	END;
    ARRCLR(lc,L);
    ARRCLR(rc,L);
    pos ← 0;
    END "End of line";

SIMPEL PROCEDURE  New!Character;
    BEGIN "New character"
    INTEGER  i, m, n, ref!code;
    PRINT( "
New character ", IF (" " < byte LEQ "Z") THEN (byte&null) ELSE ("'"&CVOS(byte)),
" being defined...
" );
    m ← GetWord("new character starting address");
    n ← GetWord("length of boundary data for new character");
    FOR i ← 1 STEP 1 UNTIL n DO
	byte ← GetByte
( "byte "&CVS(i)&" of "&CVS(n)&" bytes of boundary data for new character." );
    PRINT( CVS(n) & (" bytes of boundary data successfully read in." & crlf) );
    END "New character";

SIMPEL PROCEDURE Change!Multipliers;
    BEGIN "Change multipliers"
    PRINT( "
Change multipliers...  " );
    A ← GetWord("new horizontal multiplier");
    IF  A > 2047  THEN
	Warning(CVS(A)&" is an illegal horizontal multiplier value;
multipliers must be < 2048.");
    B ← GetWord("new vertical multiplier");
    IF  B > 2047  THEN
	Warning(CVS(B)&" is an illegal vertical multiplier value;
multipliers must be < 2048.");
    PRINT( "New multipliers are ", A, " and ", B, ".", crlf );
    END "Change multipliers";

SIMPEL PROCEDURE  Brightness!Control;
    BEGIN "Change brightness"
    INTEGER  intensity;
    PRINT( "
Brightness control...
" );
    never!brite ← false;
    IF  not brite!ok  THEN
	Warning("Cannot change brightness in the middle of a line.");
    intensity ← GetWord("new beam intensity");
    IF  intensity > 3000 or not intensity  THEN
	Warning(CVS(intensity)&" is an impossible beam intensity.");
    PRINT( "Beam intensity now set to ", intensity, ".", crlf );
    brite!ok ← false;	! Another change illegal until EOL;
    END "Change brightness";

SIMPEL PROCEDURE  End!of!Film;
    BEGIN "End of film"
    PRINT( "
End of film...
" );
    IF  not eol  THEN
	Warning(
"Without an end-of-line, everything you have typeset will be lost.");
    PRINT(
"Now operator has changed film, Alphatype displays ON LINE and we continue...
" );
    state ← 0;
    END "End of film";

SIMPEL PROCEDURE  Feed;
    BEGIN "Feed"
    INTEGER  dy;
    PRINT( "
Film-Feed...
" );
    Y ← Y + (dy ← GetWord("feed value"));
    IF  dy < 2  THEN
	Warning("Alphatype cannot feed only "&CVS(dy)&" units.")
    ELSE IF  Y > maxY  THEN
	Warning("Feeding "&CVS(dy)&" units puts the next baseline at "
		& CVS(Y+dy) & (",
which is greater than " & CVS(maxY)) );
    PRINT( "Baseline is now at ", Y, " feed units.", crlf );
    END "Feed";

SIMPEL PROCEDURE  Shuffle!Memory;
    BEGIN
    INTEGER m;
    PRINT( "
Shuffle memory taking data from character ", byte, "...
" );
    m ← GetWord("memory shuffle new-address");
    END;

SIMPEL PROCEDURE  Typeset;
    BEGIN
    INTEGER  dl, dr, newpos;
    IF  eol  THEN
	BEGIN
	eol ← false;
	PRINT("
Typesetting:
");
	END;
    IF  state = 0  THEN
	Warning(
"Typesetting is not allowed when Alphatype is in blank state.");
    IF  " " LEQ byte LEQ "z"  THEN
	PRINT( byte&null )
    ELSE
	PRINT( "|", CVOS(byte) );
    X ← GetWord("typeset horizontal coordinate");
    dl ← GetByte("left cog-increment in typeset command.");
    dr ← GetByte("right cog-increment in typeset command.");
    newpos ← (pos+1) mod 4;
    lc[newpos] ← lc[pos] + dl;
    rc[newpos] ← rc[pos] + dr;
    pos ← newpos;
    IF  lc[pos] > rc[pos]  THEN
	Warning(
"Left and right cogs have crossed.  ["&CVS(lc[pos])&","&CVS(rc[pos])&"]");
    ifc VERBOSE thenc
	PRINT(crlf,"New cogs = [",lc[pos],",",rc[pos],"].",crlf);
    endc
    END;

SIMPEL PROCEDURE  Initialize;
    BEGIN
    byte!pointer ← warnings ← state ← X ← Y ← pos ← L ← 0;
    ARRCLR(lc);
    ARRCLR(rc);
    R ← maxcog;
    A ← A!natural;  B ← B!flat;
    eol ← never!brite ← brite!ok ← true;
    END;

ifc  DEBUG  thenc
EXTERNAL PROCEDURE  Bail;
Bail;
endc

Initialize;

ifc TWENTY thenc
    PRINT( "
What is the name of the file to be digested? " );
    infile ← OPENFILE( null, "RC" );
elsec
    OPEN(infile←GETCHAN,"DSK",8,2,0,count,brchar,eof);
    DO  BEGIN
	PRINT( "
What is the name of the file to be digested? " );
	LOOKUP( infile, INCHWL, badfile );
	END
    UNTIL  not badfile;
endc

ifc DEBUG thenc
    SetPrint( null, "B" );
elsec
    SetPrint( null, "F" );
endc

WHILE  true  DO
    BEGIN "Main loop"
    byte ← GetByte;
    IF  eof  THEN  DONE "Main loop";
    CASE  byte  OF
	BEGIN
	[0]  CASE  byte ← GetByte(
"incomplete command starting with 0, one of the following:
	Adjust Cogs		( 0 & 0 & 0 )
	Display Message 	( 0 & 0 & length )
	Begin Page		( 0 & 1 )
	End of Line		( 0 & 2 )
	New Character		( 0 & character code )" )
		 OF BEGIN
		 [0]  IF  0 = byte ← GetByte(
"incomplete command starting with 0&0, one of the following:
	Adjust Cogs		( 0 & 0 & 0)
	Display Message 	( 0 & 0 & length )" )
			  THEN  Adjust!Cogs
			  ELSE  Display!Message;
		 [1]  Begin!Page;
		 [2]  End!of!Line;
		 ELSE New!Character
		 END;
	[1]  Change!Multipliers;
	[2]  CASE  byte ← GetByte(
"incomplete command starting with 2, one of the following:
	Brightness Control	( 2 & 0 )
	End of Film		( 2 & 1 )
	Feed			( 2 & 2 )
	Shuffle Memory		( 2 & character code )" )
		 OF BEGIN
		 [0]  Brightness!Control;
		 [1]  End!of!Film;
		 [2]  Feed;
		 ELSE Shuffle!Memory
		 END;
	ELSE Typeset
	END;
    END "Main loop";

SetPrint( null, "C" );

IF  warnings  THEN
    PRINT( "
Nothing fatal detected, but ", warnings, " things tasted bad." )
ELSE
    PRINT( "
Mmmmm . . . That tasted good!" );

Cleanup;

END "Taster"